home *** CD-ROM | disk | FTP | other *** search
- program IECEDir;
-
- {$path "inc/"}
- {$incl "lib/iec.lib"}
- {$incl "lib/intuition.lib"}
- {$incl "lib/graphics.lib"}
- {$incl "intuition/screens.h"}
- {$incl "graphics/view.h"}
- {$incl "libraries/diskfont.h"}
- {$incl "exec/io.h"}
- {$incl "exec/ports.h"}
-
- type colors = array[0..3] of integer;
- grafText = record
- h,
- v,
- len: integer;
- txt: string[40]
- end;
-
- var revVid, done: Boolean;
- ch: char;
- lenSep, drive,
- low, high, rowNo, size, devyce, errCode, status, i: integer;
- ptrScr: ^Screen;
- ptrWin: ^Window;
- ptrVP: ^ViewPort;
- ptrRP: ^RastPort;
- ptrMP: ^MsgPort;
- ptrIOR: ^IOStdReq;
- blues: colors;
- sep: string[3];
- countStr: string[8];
- nameC, nameS: string[32];
- font64: TextAttr;
- huh: ^TextFont;
- newS: NewScreen;
- lines: array[0..7] of grafText;
-
- procedure showLine(lineK: integer);
- begin
- Move(ptrRP, lines[lineK].h * 8, lines[lineK].v * 8 + {6}7);
- GrafxText(ptrRP, ^lines[lineK].txt, lines[lineK].len)
- end;
-
- function keybdRd: char;
- var c: char;
- status: long;
- begin
- ptrIOR^.IO_COMMAND := CMD_READ;
- ptrIOR^.IO_DATA := ^c;
- ptrIOR^.IO_LENGTH := 1;
- status := DoIO(ptrIOR);
- keybdRd := c
- end;
-
- begin
- blues[0] := $077E;
- blues[1] := $0EEE;
- blues[2] := $077E;
- blues[3] := $011C;
- lines[0].h := 4;
- lines[0].v := 1;
- lines[0].txt := '**** COMMODORE 64 BASIC V2 ****';
- lines[1].h := 1;
- lines[1].v := 3;
- lines[1].txt := '64K RAM SYSTEM 38911 BASIC BYTES FREE';
- lines[2].h := 0;
- lines[2].v := 5;
- lines[2].txt := 'READY.';
- lines[3].h := 0;
- lines[3].v := 6;
- lines[3].txt := 'LOAD"$';
- lines[4].h := 0;
- lines[4].v := 8;
- lines[4].txt := 'SEARCHING FOR $';
- lines[5].h := 0;
- lines[5].v := 9;
- lines[5].txt := 'LOADING';
- lines[6].h := 0;
- lines[6].v := 10;
- lines[6].txt := 'READY.';
- lines[7].h := 0;
- lines[7].v := 11;
- lines[7].txt := 'LIST';
- for i := 0 to 7
- do lines[i].len := length(lines[i].txt);
- OpenLib(IntBase, 'intuition.library', 0);
- OpenLib(DiskFontBase, 'diskfont.library', 0);
- OpenGfx;
- font64.ta_Name := 'C64Umod.font';
- font64.ta_YSize := 8;
- font64.ta_Style := 0;
- font64.ta_Flags := 0;
- huh := OpenDiskFont(^font64);
- newS.LeftEdge := 0;
- newS.TopEdge := 0;
- newS.Width := 320;
- newS.Height := 200;
- newS.Depth := 2;
- newS.DetailPen := 1;
- newS.BlockPen := 0;
- newS.ViewModes := 0;
- newS._Type := CUSTOMSCREEN;
- newS.Font := ^font64;
- newS.DefaultTitle := '15x1 Directory Display Screen';
- ptrScr := OpenScreen(^newS);
- ptrVP := ^ptrScr^.ViewPort;
- ptrWin := Open_Window(0,
- 0,
- 320,
- 200,
- 0,
- 1,
- 0,
- SMART_REFRESH or ACTIVATE or BORDERLESS or BACKDROP,
- '15x1 Directory Display Window',
- ptrScr,
- 0,
- 0,
- 320,
- 200);
- ptrRP := ptrWin^.RPort;
- ptrMP := CreateMsgPort;
- ptrIOR := CreateIORequest(ptrMP, sizeof(IOStdReq));
- ptrIOR^.IO_DATA := ptrWin;
- ptrIOR^.IO_LENGTH := 132;
- status := OpenDevice('console.device', 0, ptrIOR, 0);
- ShowTitle(ptrScr, {false}0);
- SetAPen(ptrRP, 2);
- SetBPen(ptrRP, 3);
- SetRast(ptrRP, 3);
- LoadRGB4(ptrVP, ^blues, 4);
- for i := 0 to 3
- do showLine(i);
- ch := 'x';
- while not ((ch = ' ') or (ch = '0') or (ch = '1'))
- do ch := keybdRd;
- if ch = '1'
- then drive := 1
- else drive := 0;
- if ch = ' '
- then begin
- sep := '",'
- lenSep := 2
- end
- else begin
- sep := ch + '",';
- lenSep := 3
- end;
- Move(ptrRP, 6 * 8, 6 * 8 + 7);
- GrafxText(ptrRP, ^sep, lenSep);
- ch := 'x';
- while not ((ch = ' ') or (ch = '1') or (ch = '8') or (ch = '9'))
- do ch := keybdRd;
- if ch = ' '
- then begin
- sep := '8';
- devyce := 8
- end
- else if ch = '1'
- then begin
- GrafxText(ptrRP, ^ch, 1);
- ch := 'x';
- while not ((ch = '0') or (ch = '1'))
- do ch := keybdRd;
- sep := ch;
- devyce := ord(ch) - 38 { ord('0') + 10 }
- end
- else begin
- sep := ch;
- devyce := ord(ch) - 48 { ord('0') }
- end;
- GrafxText(ptrRP, ^sep, 1);
- OpenIEC;
- { Ask for the directory (LOAD"$",device) }
- Listen(devyce);
- Second(CMD_OPEN + 0);
- if IECBase^.iec_ST <> ST_OK
- then writeln('Device number ', devyce, ' not responding!')
- else begin
- for i := 4 to 7
- do showLine(i);
- CIOut('$');
- CIOut(chr(drive + 48));
- UnListen;
- { Start receiving data }
- Talk(devyce);
- TkSA(CMD_DATA + 0);
- { Ignore load address }
- ch := ACPtr;
- ch := ACPtr;
- done := false;
- rowNo := 13 - 1;
- while not done
- do begin
- ch := ACPtr;
- done := IECBase^.iec_ST <> ST_OK;
- if not done
- then begin
- ch := ACPtr;
- done := IECBase^.iec_ST <> ST_OK
- end;
- if not done
- then begin { get block count }
- low := ord(ACPtr);
- done := IECBase^.iec_ST <> ST_OK;
- if not done
- then begin
- high := ord(ACPtr);
- done := IECBase^.iec_ST <> ST_OK
- end;
- end;
- if not done
- then begin { display count and name }
- if rowNo > 23
- then ScrollRaster(ptrRP, 0, 8, 0, 0, 319, 199)
- else rowNo := rowNo + 1;
- countStr := intstr(high shl 8 + low) + ' ';
- size := length(countStr);
- write(countStr);
- Move(ptrRP, 0, rowNo * 8 + {6}7);
- GrafxText(ptrRP, ^countStr, size);
- nameC := '';
- nameS := '';
- revVid := false;
- ch := ACPtr;
- while ch <> #$00
- do begin
- if ch = #$12
- then begin
- nameC := nameC + #$9B + '7m';
- revVid := true
- end
- else begin
- nameC := nameC + ch;
- nameS := nameS + ch
- end;
- ch := ACPtr
- end;
- if revVid
- then nameC := nameC + #$9B + '0m';
- writeln(nameC);
- Move(ptrRP, size * 8, rowNo * 8 + {6}7);
- if revVid
- then SetDrMd(ptrRP, 5);
- GrafxText(ptrRP, ^nameS, length(nameS));
- if revVid
- then SetDrMd(ptrRP, 1)
- end { display count and name }
- end;
- UnTalk;
- Listen(devyce);
- Second(CMD_CLOSE + 0);
- UnListen;
- ch := keybdRd
- end;
- CloseDevice(ptrIOR);
- DeleteIORequest(ptrIOR);
- DeleteMsgPort(ptrMP);
- Close_Window(ptrWin);
- CloseScreen(ptrScr)
- end.
-